home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
proptest
/
proptest.pas
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
4KB
|
172 lines
unit Proptest;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
DsgnIntf,
Forms, Dialogs;
type
TA = class(TPersistent)
protected
FText : string;
published
property Text : string read FText write FText;
end;
TB = class(TPersistent)
protected
FA : TA;
FArr : Array[0..9] of integer;
procedure SetA(AA : TA);
procedure SetArr(Index, AVal : integer);
function GetArr(Index : integer) : Integer;
procedure DefineProperties(Filer: TFiler); override;
procedure WriteArr(Writer: TWriter);
procedure ReadArr(Reader: TReader);
public
constructor Create;
destructor Destroy; override;
property Arr[Index : integer] : integer read GetArr write SetArr;
published
property A : TA read FA write SetA;
end;
type
TPropTest = class(TWinControl)
protected
FB : TB;
procedure SetB(AB : TB);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property B : TB read FB write SetB;
end;
TBProperty = class(TClassProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
procedure Register;
implementation
uses
ubdialog;
{========================================}
procedure Register;
begin
RegisterComponents('Tests', [TPropTest]);
RegisterPropertyEditor(TypeInfo(TB),nil,'',TBProperty);
end;
{========================================}
constructor TPropTest.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FB := TB.Create;
end;
{========================================}
destructor TPropTest.Destroy;
begin
FB.Free;
Inherited Destroy;
end;
{========================================}
procedure TPropTest.SetB(AB : TB);
begin
FB.Assign(AB);
end;
{========================================}
{========================================}
constructor TB.Create;
var
i : integer;
begin
for i := 0 to 9 do
Arr[i] := i;
FA := TA.Create;
end;
{========================================}
destructor TB.Destroy;
begin
FA.Free;
Inherited Destroy;
end;
{========================================}
procedure TB.SetA(AA : TA);
begin
FA.Assign(AA);
end;
{========================================}
procedure TB.SetArr(Index, AVal : integer);
begin
FArr[Index] := AVal;
end;
{========================================}
function TB.GetArr(Index : integer) : Integer;
begin
result := FArr[Index];
end;
{========================================}
procedure TB.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('Arr', ReadArr, WriteArr, True);
end;
{========================================}
procedure TB.WriteArr(Writer: TWriter);
var
i : integer;
begin
for i := 0 to 9 do
Writer.WriteInteger(Arr[i]);
end;
{========================================}
procedure TB.ReadArr(Reader: TReader);
var
i : integer;
begin
for i := 0 to 9 do
Arr[i] := Reader.ReadInteger;
end;
{========================================}
{========================================}
procedure TBProperty.Edit;
var
BDialog: TBDialog;
begin
BDialog := TBDialog.Create(Application);
try
BDialog.B := TB(GetOrdValue);
BDialog.ShowModal;
finally
BDialog.Free;
end;
end;
{========================================}
function TBProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
end.